perm filename MATRIX.FAI[SYS,HE] blob sn#004229 filedate 1972-06-06 generic text, type T, neo UTF8
00100		ENTRY MTIMES,MPLUS,MSCALE,MMOVE,TRACET
00200		TITLE MATRIX
00300	
00400		↓BITS←0
00500		↓S←1
00600		↓M←2
00700		↓A1←3
00800		↓A2←4
00900		↓A3←5
01000		↓A4←6
01100		↓I←7
01200		↓R←10
01300		↓T←11
01400		↓U←12
01500		↓MAT←13
01600		↓TRA←14
01700		↓STAT←15
01800		↓P←17
01900	
02000	↓MLT:	BLOCK =17
02100		DEFINE POPR & (A) {
02200		SUB P,X&A&A
02300		JRST @A(P)⎇
02400	
02450	↓USAV:	0
02500	↓X11:	1(1)
02600	↓X22:	2(2)
02700	↓X33:	3(3)
02800	↓X44:	4(4)
     

00100		BEGIN MATMUL
00200	↑MTIMES:MOVEM U,USAV
00250		HRRZ R,-3(P)
00300		HRRZ U,-2(P)
00400		HRRZ M,-1(P)
01100	
01200		SETCM MAT,20(U)
01300		TRNN MAT,177777
01350		JRST LZ
01400		SETCM A1,20(M)
01500		TRNN A1,177777
01550		JRST LZ
01600		MOVEI S,MLT
01700		HRLI S,(M)
01800		BLT S,MLT+17
01900	
02000		MOVEI TRA,102041	;COMPUTE TRANSPOSE OF BITS
02100		ANDI TRA,(A1)
02200		MOVEI M,41020
02300		ANDI M,(A1)
02400		LSH M,-3
02500		IORI TRA,(M)
02600		MOVEI M,4102
02700		ANDI M,(A1)
02800		LSH M,3
02900		IORI TRA,(M)
03000		TRNE A1,20000
03100		TRO TRA,200
03200		TRNE A1,10000
03300		TRO TRA,10
03400		TRNE A1,400
03500		TRO TRA,4
03600		TRNE A1,200
03700		TRO TRA,20000
03800		TRNE A1,10
03900		TRO TRA,10000
04000		TRNE A1,4
04100		TRO TRA,400
04200	
04300		HRLZI MAT,(MAT)
04400		LSH MAT,2
04500		MOVEI I,4
04600		SETO STAT,
     

00100	LL:	LSH STAT,4
00200		HRRI MAT,
00300		ROT MAT,4
00400		MOVE BITS,MASK(MAT)
00500		ANDI BITS,(TRA)
00700		MOVE A1,(U)
00800		MOVE A2,1(U)
00900		MOVE A3,2(U)
01000		MOVE A4,3(U)
01100		SETZB S,3(R)
01200		TRNN BITS,17
01300		JRST L1
01400		TRNN BITS,10
01500		JRST L11
01600		MOVE S,A1
01700		FMPR S,MLT+3
01800	L11:	TRNN BITS,4
01900		JRST L12
02000		MOVE M,A2
02100		FMPR M,MLT+7
02200		FADR S,M
02300	L12:	TRNN BITS,2
02400		JRST L13
02500		MOVE M,A3
02600		FMPR M,MLT+13
02700		FADR S,M
02800	L13:	TRNN BITS,1
02900		JRST L14
03000		MOVE M,A4
03100		FMPR M,MLT+17
03200		FADR S,M
03300	L14:	JUMPE S,L1
03400		TRO STAT,1
03500		MOVEM S,3(R)
03600	L1:	SETZB S,2(R)
03700		TRNN BITS,360
03800		JRST L2
03900		TRNN BITS,200
04000		JRST L21
04100		MOVE S,A1
04200		FMPR S,MLT+2
04300	L21:	TRNN BITS,100
04400		JRST L22
04500		MOVE M,A2
04600		FMPR M,MLT+6
04700		FADR S,M
04800	L22:	TRNN BITS,40
04900		JRST L23
05000		MOVE M,A3
05100		FMPR M,MLT+12
05200		FADR S,M
05300	L23:	TRNN BITS,20
05400		JRST L24
05500		MOVE M,A4
05600		FMPR M,MLT+16
05700		FADR S,M
05800	L24:	JUMPE S,L2
05900		TRO STAT,2
06000		MOVEM S,2(R)
06100	L2:	SETZB S,1(R)
06200		TRNN BITS,7400
06300		JRST L3
06400		TRNN BITS,4000
06500		JRST L31
06600		MOVE S,A1
06700		FMPR S,MLT+1
06800	L31:	TRNN BITS,2000
06900		JRST L32
07000		MOVE M,A2
07100		FMPR M,MLT+5
07200		FADR S,M
07300	L32:	TRNN BITS,1000
07400		JRST L33
07500		MOVE M,A3
07600		FMPR M,MLT+11
07700		FADR S,M
07800	L33:	TRNN BITS,400
07900		JRST L34
08000		MOVE M,A4
08100		FMPR M,MLT+15
08200		FADR S,M
08300	L34:	JUMPE S,L3
08400		TRO STAT,4
08500		MOVEM S,1(R)
08600	L3:	SETZB S,(R)
08700		TRNN BITS,170000
08800		JRST L4
08900		TRNN BITS,100000
09000		JRST L41
09100		FMPR A1,MLT
09200		MOVE S,A1
09300	L41:	TRNN BITS,40000
09400		JRST L42
09500		FMPR A2,MLT+4
09600		FADR S,A2
09700	L42:	TRNN BITS,20000
09800		JRST L43
09900		FMPR A3,MLT+10
10000		FADR S,A3
10100	L43:	TRNN BITS,10000
10200		JRST L44
10300		FMPR A4,MLT+14
10400		FADR S,A4
10500	L44:	JUMPE S,L4
10600		TRO STAT,10
10700		MOVEM S,(R)
10800	L4:	ADDI U,4
10900		ADDI R,4
11000		SOJG I,LL
11100		SETCAM STAT,(R)
11150		MOVE U,USAV
11200	L00:	POPR 4
11300	MASK:	0
11400		10421
11500		21042
11600		31463
11700		42104
11800		52525
11900		63146
12000		73567
12100		104210
12200		114631
12300		125252
12400		135673
12500		146314
12600		156735
12700		167356
12800		177777
12810	
12825	LZ:	SETZM (R)
12840		HRRZI S,(R)
12855		HRLI S,(R)
12870		AOJ S,
12885		BLT S,17(R)
12892		MOVEI S,177777
12896		MOVEM S,20(R)
12898		JRST L00
12900		BEND
     

00100		BEGIN MPLUS
00200	↑MPLUS:	MOVEM U,USAV
00250		HRRZ R,-3(P)
00300		HRRZ U,-2(P)
00400		HRRZ T,-1(P)
00800	
00900		MOVE BITS,20(U)
01000		AND BITS,20(T)
01100		MOVEM BITS,20(R)
01300	
01400		TRNE BITS,1
01500		JRST .+4
01600		MOVE S,17(T)
01650		FADR S,17(U)
01700		MOVEM S,17(R)
01800		TRNE BITS,2
01900		JRST .+4
02000		MOVE S,16(T)
02050		FADR S,16(U)
02100		MOVEM S,16(R)
02200		TRNE BITS,4
02300		JRST .+4
02400		MOVE S,15(T)
02450		FADR S,15(U)
02500		MOVEM S,15(R)
02600		TRNE BITS,10
02700		JRST .+4
02800		MOVE S,14(T)
02850		FADR S,14(U)
02900		MOVEM S,14(R)
03000		TRNE BITS,20
03100		JRST .+4
03200		MOVE S,13(T)
03250		FADR S,13(U)
03300		MOVEM S,13(R)
03400		TRNE BITS,40
03500		JRST .+4
03600		MOVE S,12(T)
03650		FADR S,12(U)
03700		MOVEM S,12(R)
03800		TRNE BITS,100
03900		JRST .+4
04000		MOVE S,11(T)
04050		FADR S,11(U)
04100		MOVEM S,11(R)
04200		TRNE BITS,200
04300		JRST .+4
04400		MOVE S,10(T)
04450		FADR S,10(U)
04500		MOVEM S,10(R)
04600		TRNE BITS,400
04700		JRST .+4
04800		MOVE S,7(T)
04850		FADR S,7(U)
04900		MOVEM S,7(R)
05000		TRNE BITS,1000
05100		JRST .+4
05200		MOVE S,6(T)
05250		FADR S,6(U)
05300		MOVEM S,6(R)
05400		TRNE BITS,2000
05500		JRST .+4
05600		MOVE S,5(T)
05650		FADR S,5(U)
05700		MOVEM S,5(R)
05800		TRNE BITS,4000
05900		JRST .+4
06000		MOVE S,4(T)
06050		FADR S,4(U)
06100		MOVEM S,4(R)
06200		TRNE BITS,10000
06300		JRST .+4
06400		MOVE S,3(T)
06450		FADR S,3(U)
06500		MOVEM S,3(R)
06600		TRNE BITS,20000
06700		JRST .+4
06800		MOVE S,2(T)
06850		FADR S,2(U)
06900		MOVEM S,2(R)
07000		TRNE BITS,40000
07100		JRST .+4
07200		MOVE S,1(T)
07250		FADR S,1(U)
07300		MOVEM S,1(R)
07400		TRNE BITS,100000
07500		JRST .+4
07600		MOVE S,(T)
07650		FADR S,(U)
07700		MOVEM S,(R)
07750		MOVE U,USAV
07800		POPR 4
07900		BEND
     

00100		BEGIN MSCALE
00200	↑MSCALE:HRRZ R,-2(P)
00300		MOVE S,-1(P)
00310		JUMPN S,L2
00320		SETZM (R)
00330		HRRI S,(R)
00340		HRLI S,(R)
00350		AOJ S,
00360		BLT S,17(R)
00370		MOVEI S,177777
00380		MOVEM S,20(R)
00390		JRST L1
00400	L2:	SETCM BITS,20(R)
00500		TRNN BITS,177777
00600		JRST L1
00700		TRNN BITS,1
00800		JRST .+2
00900		FMPRM S,17(R)
01000		TRNN BITS,2
01100		JRST .+2
01200		FMPRM S,16(R)
01300		TRNN BITS,4
01400		JRST .+2
01500		FMPRM S,15(R)
01600		TRNN BITS,10
01700		JRST .+2
01800		FMPRM S,14(R)
01900		TRNN BITS,20
02000		JRST .+2
02100		FMPRM S,13(R)
02200		TRNN BITS,40
02300		JRST .+2
02400		FMPRM S,12(R)
02500		TRNN BITS,100
02600		JRST .+2
02700		FMPRM S,11(R)
02800		TRNN BITS,200
02900		JRST .+2
03000		FMPRM S,10(R)
03100		TRNN BITS,400
03200		JRST .+2
03300		FMPRM S,7(R)
03400		TRNN BITS,1000
03500		JRST .+2
03600		FMPRM S,6(R)
03700		TRNN BITS,2000
03800		JRST .+2
03900		FMPRM S,5(R)
04000		TRNN BITS,4000
04100		JRST .+2
04200		FMPRM S,4(R)
04300		TRNN BITS,10000
04400		JRST .+2
04500		FMPRM S,3(R)
04600		TRNN BITS,20000
04700		JRST .+2
04800		FMPRM S,2(R)
04900		TRNN BITS,40000
05000		JRST .+2
05100		FMPRM S,1(R)
05200		TRNN BITS,100000
05300		JRST .+2
05400		FMPRM S,(R)
05500	L1:	POPR 3
05600		BEND
     

00100		BEGIN MMOVE
00200	↑MMOVE:	HRRZ R,-2(P)
00300		HRRZ T,-1(P)
00400		TRO STAT,177777
00500		SKIPE S,17(T)
00600		TRZ STAT,1
00700		MOVEM S,17(R)
00800		SKIPE S,16(T)
00900		TRZ STAT,2
01000		MOVEM S,16(R)
01100		SKIPE S,15(T)
01200		TRZ STAT,4
01300		MOVEM S,15(R)
01400		SKIPE S,14(T)
01500		TRZ STAT,10
01600		MOVEM S,14(R)
01700		SKIPE S,13(T)
01800		TRZ STAT,20
01900		MOVEM S,13(R)
02000		SKIPE S,12(T)
02100		TRZ STAT,40
02200		MOVEM S,12(R)
02300		SKIPE S,11(T)
02400		TRZ STAT,100
02500		MOVEM S,11(R)
02600		SKIPE S,10(T)
02700		TRZ STAT,200
02800		MOVEM S,10(R)
02900		SKIPE S,7(T)
03000		TRZ STAT,400
03100		MOVEM S,7(R)
03200		SKIPE S,6(T)
03300		TRZ STAT,1000
03400		MOVEM S,6(R)
03500		SKIPE S,5(T)
03600		TRZ STAT,2000
03700		MOVEM S,5(R)
03800		SKIPE S,4(T)
03900		TRZ STAT,4000
04000		MOVEM S,4(R)
04100		SKIPE S,3(T)
04200		TRZ STAT,10000
04300		MOVEM S,3(R)
04400		SKIPE S,2(T)
04500		TRZ STAT,20000
04600		MOVEM S,2(R)
04700		SKIPE S,1(T)
04800		TRZ STAT,40000
04900		MOVEM S,1(R)
05000		SKIPE S,(T)
05100		TRZ STAT,100000
05200		MOVEM S,(R)
05300		MOVEM STAT,20(R)
05400		POPR 3
05500		BEND
     

00100		BEGIN TRACET
00200	↑TRACET:MOVEM U,USAV
00250		HRRZ R,-2(P)
00300		HRRZ U,-1(P)
00400		SETZB 1,2
00500		SETCM BITS,20(R)
00600		ANDCM BITS,20(U)
00700		TRNN BITS,177777
00750		JRST L3
00800		MOVEI I,20
00900	L1:	TRNN BITS,1
01000		JRST L2
01100		MOVE 4,17(R)
01200		FMPL 4,17(U)
01300		UFA 2,5
01400		FADL 1,4
01500		UFA 2,3
01600		FADL 1,3
01700	L2:	LSH BITS,-1
01800		SOJ R,
01900		SOJ U,
02000		SOJG I,L1
02050		MOVE U,USAV
02100	L3:	POPR 3
02200		BEND
     

00100		END